Previsões gestantes
Daniel Pagotto e Adaleny Paiva
13/02/2022
Status de saúde - Previsões
Trazendo dados da MLP
Trazendo os dados de MLP treinados pelo Diogo
resultados_mlp_prophet <- read_csv("resultados_mlp_prophet.csv")
resultados_mlp_graph <-
resultados_mlp_prophet %>%
filter(model == 'mlp') %>%
mutate(model = 'MLP') %>%
select(-`...1`) %>%
mutate(mes_ano = my(mes_ano)) %>%
mutate(macrorregiao_pad = case_when(codibge == 5206 ~ 'MACRORREGIAO SUDOESTE',
codibge == 5207 ~ 'MACRORREGIAO NORDESTE',
codibge == 5208 ~ 'MACRORREGIAO CENTRO-OESTE',
codibge == 5209 ~ 'MACRORREGIAO CENTRO-NORTE',
codibge == 5210 ~ 'MACRORREGIAO CENTRO SUDESTE')) %>%
select(macrorregiao_pad, mes_ano, model, total_nasc) %>%
filter(mes_ano < '2022-01-01') Baixando dados para demais modelos
Primeiro, vamos baixar os dados de nascidos e outras bases que possam contribuir para as análises.
Vamos, primeiramente, baixar os dados de Goiás e fazer alguns tratamentos (ex.: unir as colunas mês e ano)
nascidos <- sqlQuery(channel, 'SELECT * FROM "Analytics Layer"."Epidemiológico".Nascimentos."Nascidos Vivos por Macrorregião de Saúde"', as.is = TRUE)
nascidos$quantidade <- as.numeric(nascidos$quantidade)
nascidos_go <- nascidos %>%
filter(uf_sigla == "GO") %>%
mutate(mes_ano = paste(mes, ano, sep = ""),
mes_ano = my(mes_ano)) %>%
select(-mes,-ano) %>%
filter(mes_ano < "2022-01-01")Visualizando o número de nascidos por macrorregião.
a <- nascidos_go %>%
ggplot(aes(x = mes_ano, y = quantidade, col = macrorregiao_pad)) + geom_line() +
theme_minimal()
plotly::ggplotly(a)Aplicando modeltime na macrorregião Centro-Oeste
Primeiramente, vamos aplicar o modeltime apenas para a macrorregião Centro-Oeste.
Dividindo a base por treino e teste, usando os últimos 12 meses.
regiao_centro_oeste <- nascidos_go %>%
filter(macrorregiao_pad == "MACRORREGIAO CENTRO-OESTE") %>%
ungroup() %>%
select(-macrorregiao_pad)
splits_regiao_centro_oeste <- time_series_split(
regiao_centro_oeste,
assess = "12 months",
cumulative = TRUE
)
splits_regiao_centro_oeste %>%
tk_time_series_cv_plan() %>%
plot_time_series_cv_plan(mes_ano, quantidade)splits_regiao_centro_oeste## <Analysis/Assess/Total>
## <252/12/264>Treinando modelos
model_arima_regiao_centro_oeste <- arima_reg() %>%
set_engine("auto_arima") %>%
fit(quantidade ~ mes_ano, training(splits_regiao_centro_oeste))
model_prophet_regiao_centro_oeste <- prophet_reg(seasonality_yearly = TRUE) %>%
set_engine("prophet") %>%
fit(quantidade ~ mes_ano, training(splits_regiao_centro_oeste))
model_fit_ets_regiao_centro_oeste <- exp_smoothing() %>%
set_engine(engine = "ets") %>%
fit(quantidade ~ mes_ano, data = training(splits_regiao_centro_oeste))
model_tbl_regiao_centro_oeste <- modeltime_table(
model_arima_regiao_centro_oeste,
model_prophet_regiao_centro_oeste,
model_fit_ets_regiao_centro_oeste
)Vamos avaliar a performance preditiva dos modelos.
calib_tbl_regiao_centro_oeste <- model_tbl_regiao_centro_oeste %>%
modeltime_calibrate(testing(splits_regiao_centro_oeste))
calib_tbl_regiao_centro_oeste %>% modeltime_accuracy()## # A tibble: 3 × 9
## .model_id .model_desc .type mae mape mase smape rmse rsq
## <int> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 ARIMA(1,0,0)(1,1,0)[12] W… Test 152. 6.30 1.44 6.03 185. 0.432
## 2 2 PROPHET Test 143. 5.89 1.35 5.67 165. 0.638
## 3 3 ETS(M,N,A) Test 95.4 3.95 0.904 3.83 121. 0.639De acordo com os resultados dos três algoritmos testados, o ETS possui melhor resultado, com MAPE, MAE e RMSE menores.
ets_treino_regiao_centro_oeste <- calib_tbl_regiao_centro_oeste[[5]][[3]] %>%
select(-.residuals) %>%
mutate(macrorregiao_pad = 'MACRORREGIAO CENTRO-OESTE',
.before = mes_ano) %>%
gather(key = 'model',
value = 'total_nasc',
3:4) %>%
mutate(model = if_else(model == '.prediction',
'ETS',
'REAL'))
graph <- resultados_mlp_graph %>%
filter(macrorregiao_pad == 'MACRORREGIAO CENTRO-OESTE')
ets_mlp_centro_oeste <- rbind(ets_treino_regiao_centro_oeste,graph)
ets_mlp_centro_oeste %>%
ggplot(aes(x = mes_ano, y = total_nasc, col = model)) + geom_line(size = 0.8) +
theme_minimal() + xlab("Mês e ano") + ylab("Nascimentos")
calib_tbl_regiao_centro_oeste %>%
modeltime_forecast(
new_data = testing(splits_regiao_centro_oeste),
actual_data = regiao_centro_oeste
) %>%
plot_modeltime_forecast(.conf_interval_show = FALSE)Apesar do ETS apresentar melhores resultados em termos de métricas, uma inspeção visual sugere a adoção do Prophet, pois o primeiro não está capturando a tendência de queda.
future_forecast_tbl_regiao_centro_oeste <- calib_tbl_regiao_centro_oeste %>%
modeltime_refit(regiao_centro_oeste) %>%
modeltime_forecast(h = "24 months",
actual_data = regiao_centro_oeste)
future_forecast_tbl_regiao_centro_oeste %>%
plot_modeltime_forecast(.conf_interval_show = FALSE)future_forecast_tbl_regiao_centro_oeste %>%
filter(.model_desc == "PROPHET" | .model_desc == "ACTUAL") %>%
filter(.index > "2019-01-01") %>%
ggplot(aes(x = .index, y = .value, col = .key)) + geom_line() +
theme_minimal()
Aplicando modeltime na macrorregião Nordeste
Dividindo a base por treino e teste, usando os últimos 12 meses.
regiao_nordeste <- nascidos_go %>%
filter(macrorregiao_pad == "MACRORREGIAO NORDESTE") %>%
ungroup() %>%
select(-macrorregiao_pad)
splits_regiao_nordeste <- time_series_split(
regiao_nordeste,
assess = "12 months",
cumulative = TRUE
)
splits_regiao_nordeste %>%
tk_time_series_cv_plan() %>%
plot_time_series_cv_plan(mes_ano, quantidade)splits_regiao_nordeste## <Analysis/Assess/Total>
## <252/12/264>Treinando modelos
model_arima_regiao_nordeste <- arima_reg() %>%
set_engine("auto_arima") %>%
fit(quantidade ~ mes_ano, training(splits_regiao_nordeste))
model_prophet_regiao_nordeste <- prophet_reg(seasonality_yearly = TRUE) %>%
set_engine("prophet") %>%
fit(quantidade ~ mes_ano, training(splits_regiao_nordeste))
model_fit_ets_regiao_nordeste <- exp_smoothing() %>%
set_engine(engine = "ets") %>%
fit(quantidade ~ mes_ano, data = training(splits_regiao_nordeste))
model_tbl_regiao_nordeste <- modeltime_table(
model_arima_regiao_nordeste,
model_prophet_regiao_nordeste,
model_fit_ets_regiao_nordeste
)Vamos avaliar a performance preditiva dos modelos.
calib_tbl_regiao_nordeste <- model_tbl_regiao_nordeste %>%
modeltime_calibrate(testing(splits_regiao_nordeste))
calib_tbl_regiao_nordeste %>% modeltime_accuracy()## # A tibble: 3 × 9
## .model_id .model_desc .type mae mape mase smape rmse rsq
## <int> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 ARIMA(3,0,0)(2,1,2)[12] Test 25.4 1.67 0.248 1.66 31.5 0.872
## 2 2 PROPHET Test 29.1 1.88 0.284 1.89 39.2 0.798
## 3 3 ETS(A,N,A) Test 27.5 1.79 0.269 1.79 36.8 0.822De acordo com os resultados dos três algoritmos testados, o ARIMA possui melhor resultado, com MAPE, MAE e RMSE menores.
arima_treino_regiao_nordeste <- calib_tbl_regiao_nordeste[[5]][[1]] %>%
select(-.residuals) %>%
mutate(macrorregiao_pad = 'MACRORREGIAO NORDESTE',
.before = mes_ano) %>%
gather(key = 'model',
value = 'total_nasc',
3:4) %>%
mutate(model = if_else(model == '.prediction',
'ARIMA',
'REAL'))
arima_treino_regiao_nordeste %>%
ggplot(aes(x = mes_ano, y = total_nasc, col = model)) + geom_line() + theme_minimal()
calib_tbl_regiao_nordeste %>%
modeltime_forecast(
new_data = testing(splits_regiao_nordeste),
actual_data = regiao_nordeste
) %>%
plot_modeltime_forecast(.conf_interval_show = FALSE)A ARIMA apresentar melhores resultados em termos de métricas.
future_forecast_tbl_regiao_nordeste <- calib_tbl_regiao_nordeste %>%
modeltime_refit(regiao_nordeste) %>%
modeltime_forecast(h = "24 months",
actual_data = regiao_nordeste)
future_forecast_tbl_regiao_nordeste %>%
plot_modeltime_forecast(.conf_interval_show = FALSE)future_forecast_tbl_regiao_nordeste %>%
filter(.model_desc == "ARIMA" | .model_desc == "ACTUAL") %>%
filter(.index > "2019-01-01") %>%
ggplot(aes(x = .index, y = .value, col = .key)) + geom_line() +
theme_minimal()
Aplicando modeltime na macrorregião Centro Sudeste
Dividindo a base por treino e teste, usando os últimos 12 meses.
regiao_centro_sudeste <- nascidos_go %>%
filter(macrorregiao_pad == "MACRORREGIAO CENTRO SUDESTE") %>%
ungroup() %>%
select(-macrorregiao_pad)
splits_regiao_centro_sudeste <- time_series_split(
regiao_centro_sudeste,
assess = "12 months",
cumulative = TRUE
)
splits_regiao_centro_sudeste %>%
tk_time_series_cv_plan() %>%
plot_time_series_cv_plan(mes_ano, quantidade)splits_regiao_centro_sudeste## <Analysis/Assess/Total>
## <252/12/264>Treinando modelos
model_arima_regiao_centro_sudeste <- arima_reg() %>%
set_engine("auto_arima") %>%
fit(quantidade ~ mes_ano, training(splits_regiao_centro_sudeste))
model_prophet_regiao_centro_sudeste <- prophet_reg(seasonality_yearly = TRUE) %>%
set_engine("prophet") %>%
fit(quantidade ~ mes_ano, training(splits_regiao_centro_sudeste))
model_fit_ets_regiao_centro_sudeste <- exp_smoothing() %>%
set_engine(engine = "ets") %>%
fit(quantidade ~ mes_ano, data = training(splits_regiao_centro_sudeste))
model_tbl_regiao_centro_sudeste <- modeltime_table(
model_arima_regiao_centro_sudeste,
model_prophet_regiao_centro_sudeste,
model_fit_ets_regiao_centro_sudeste
)Vamos avaliar a performance preditiva dos modelos.
calib_tbl_regiao_centro_sudeste <- model_tbl_regiao_centro_sudeste %>%
modeltime_calibrate(testing(splits_regiao_centro_sudeste))
calib_tbl_regiao_centro_sudeste %>% modeltime_accuracy()## # A tibble: 3 × 9
## .model_id .model_desc .type mae mape mase smape rmse rsq
## <int> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 ARIMA(1,0,0)(1,1,2)[12] Test 88.5 5.62 0.891 5.41 104. 0.694
## 2 2 PROPHET Test 71.4 4.54 0.719 4.40 82.3 0.791
## 3 3 ETS(A,N,A) Test 47.0 2.98 0.473 2.91 59.2 0.797De acordo com os resultados dos três algoritmos testados, o ETS possui melhor resultado, com MAPE, MAE e RMSE menores.
ets_treino_regiao_centro_sudeste <- calib_tbl_regiao_centro_sudeste[[5]][[3]] %>%
select(-.residuals) %>%
mutate(macrorregiao_pad = 'MACRORREGIAO CENTRO SUDESTE',
.before = mes_ano) %>%
gather(key = 'model',
value = 'total_nasc',
3:4) %>%
mutate(model = if_else(model == '.prediction',
'ETS',
'REAL'))
ets_treino_regiao_centro_sudeste %>%
ggplot(aes(x = mes_ano, y = total_nasc, col = model)) + geom_line() + theme_minimal()
calib_tbl_regiao_centro_sudeste %>%
modeltime_forecast(
new_data = testing(splits_regiao_centro_sudeste),
actual_data = regiao_centro_sudeste
) %>%
plot_modeltime_forecast(.conf_interval_show = FALSE)A ETS apresentar melhores resultados em termos de métricas.
future_forecast_tbl_regiao_centro_sudeste <- calib_tbl_regiao_centro_sudeste %>%
modeltime_refit(regiao_centro_sudeste) %>%
modeltime_forecast(h = "24 months",
actual_data = regiao_centro_sudeste)
future_forecast_tbl_regiao_centro_sudeste%>%
plot_modeltime_forecast(.conf_interval_show = FALSE)future_forecast_tbl_regiao_centro_sudeste %>%
filter(.model_desc == "ETS" | .model_desc == "ACTUAL") %>%
filter(.index > "2019-01-01") %>%
ggplot(aes(x = .index, y = .value, col = .key)) + geom_line() +
theme_minimal()
Aplicando modeltime na macrorregião Centro norte
Dividindo a base por treino e teste, usando os últimos 12 meses.
regiao_centro_norte <- nascidos_go %>%
filter(macrorregiao_pad == "MACRORREGIAO CENTRO-NORTE") %>%
ungroup() %>%
select(-macrorregiao_pad)
splits_regiao_centro_norte <- time_series_split(
regiao_centro_norte,
assess = "12 months",
cumulative = TRUE
)
splits_regiao_centro_norte %>%
tk_time_series_cv_plan() %>%
plot_time_series_cv_plan(mes_ano, quantidade)splits_regiao_centro_norte## <Analysis/Assess/Total>
## <252/12/264>Treinando modelos
model_arima_regiao_centro_norte <- arima_reg() %>%
set_engine("auto_arima") %>%
fit(quantidade ~ mes_ano, training(splits_regiao_centro_norte))
model_prophet_regiao_centro_norte <- prophet_reg(seasonality_yearly = TRUE) %>%
set_engine("prophet") %>%
fit(quantidade ~ mes_ano, training(splits_regiao_centro_norte))
model_fit_ets_regiao_centro_norte <- exp_smoothing() %>%
set_engine(engine = "ets") %>%
fit(quantidade ~ mes_ano, data = training(splits_regiao_centro_norte))
model_tbl_regiao_centro_norte <- modeltime_table(
model_arima_regiao_centro_norte,
model_prophet_regiao_centro_norte,
model_fit_ets_regiao_centro_norte
)Vamos avaliar a performance preditiva dos modelos.
calib_tbl_regiao_centro_norte <- model_tbl_regiao_centro_norte %>%
modeltime_calibrate(testing(splits_regiao_centro_norte))
calib_tbl_regiao_centro_norte %>% modeltime_accuracy()## # A tibble: 3 × 9
## .model_id .model_desc .type mae mape mase smape rmse rsq
## <int> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 ARIMA(3,0,1)(2,1,0)[12] Test 41.7 3.40 0.662 3.41 50.4 0.506
## 2 2 PROPHET Test 40.8 3.38 0.647 3.31 48.7 0.614
## 3 3 ETS(A,N,A) Test 33.1 2.71 0.525 2.72 40.1 0.630De acordo com os resultados dos três algoritmos testados, o ETS possui melhor resultado, com MAPE, MAE e RMSE menores.
ets_treino_regiao_centro_norte <- calib_tbl_regiao_centro_norte[[5]][[3]] %>%
select(-.residuals) %>%
mutate(macrorregiao_pad = 'MACRORREGIAO CENTRO-NORTE',
.before = mes_ano) %>%
gather(key = 'model',
value = 'total_nasc',
3:4) %>%
mutate(model = if_else(model == '.prediction',
'ETS',
'REAL'))
ets_treino_regiao_centro_norte %>%
ggplot(aes(x = mes_ano, y = total_nasc, col = model)) + geom_line() + theme_minimal()
calib_tbl_regiao_centro_norte %>%
modeltime_forecast(
new_data = testing(splits_regiao_centro_norte),
actual_data = regiao_centro_norte
) %>%
plot_modeltime_forecast(.conf_interval_show = FALSE)Apesar do ETS apresentar melhores resultados em termos de métricas, uma inspeção visual sugere a adoção do ARIMA, pois o primeiro não está capturando a tendência de queda.
future_forecast_tbl_regiao_centro_norte <- calib_tbl_regiao_centro_norte %>%
modeltime_refit(regiao_centro_norte) %>%
modeltime_forecast(h = "24 months",
actual_data = regiao_centro_norte)
future_forecast_tbl_regiao_centro_norte%>%
plot_modeltime_forecast(.conf_interval_show = FALSE)future_forecast_tbl_regiao_centro_norte %>%
filter(.model_desc == "ARIMA" | .model_desc == "ACTUAL") %>%
filter(.index > "2019-01-01") %>%
ggplot(aes(x = .index, y = .value, col = .key)) + geom_line() +
theme_minimal()
Aplicando modeltime na macrorregião Sudoeste
Dividindo a base por treino e teste, usando os últimos 12 meses.
regiao_sudoeste <- nascidos_go %>%
filter(macrorregiao_pad == "MACRORREGIAO SUDOESTE") %>%
ungroup() %>%
select(-macrorregiao_pad)
splits_regiao_sudoeste <- time_series_split(
regiao_sudoeste,
assess = "12 months",
cumulative = TRUE
)
splits_regiao_sudoeste %>%
tk_time_series_cv_plan() %>%
plot_time_series_cv_plan(mes_ano, quantidade)splits_regiao_sudoeste## <Analysis/Assess/Total>
## <252/12/264>Treinando modelos
model_arima_regiao_sudoeste <- arima_reg() %>%
set_engine("auto_arima") %>%
fit(quantidade ~ mes_ano, training(splits_regiao_sudoeste))
model_prophet_regiao_sudoeste <- prophet_reg(seasonality_yearly = TRUE) %>%
set_engine("prophet") %>%
fit(quantidade ~ mes_ano, training(splits_regiao_sudoeste))
model_fit_ets_regiao_sudoeste <- exp_smoothing() %>%
set_engine(engine = "ets") %>%
fit(quantidade ~ mes_ano, data = training(splits_regiao_sudoeste))
model_tbl_regiao_sudoeste <- modeltime_table(
model_arima_regiao_sudoeste,
model_prophet_regiao_sudoeste,
model_fit_ets_regiao_sudoeste
) Vamos avaliar a performance preditiva dos modelos.
calib_tbl_regiao_sudoeste <- model_tbl_regiao_sudoeste %>%
modeltime_calibrate(testing(splits_regiao_sudoeste))
calib_tbl_regiao_sudoeste %>% modeltime_accuracy()## # A tibble: 3 × 9
## .model_id .model_desc .type mae mape mase smape rmse rsq
## <int> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 ARIMA(3,0,1)(2,1,0)[12] Test 45.3 5.99 2.11 5.74 55.6 0.306
## 2 2 PROPHET Test 45.6 6.04 2.13 5.79 54.9 0.316
## 3 3 ETS(M,N,A) Test 33.6 4.45 1.56 4.31 43.5 0.329De acordo com os resultados dos três algoritmos testados, o ETS possui melhor resultado, com MAPE, MAE e RMSE menores.
ets_treino_regiao_sudoeste <- calib_tbl_regiao_sudoeste[[5]][[3]] %>%
select(-.residuals) %>%
mutate(macrorregiao_pad = 'MACRORREGIAO SUDOESTE',
.before = mes_ano) %>%
gather(key = 'model',
value = 'total_nasc',
3:4) %>%
mutate(model = if_else(model == '.prediction',
'ETS',
'REAL'))
ets_treino_regiao_sudoeste %>%
ggplot(aes(x = mes_ano, y = total_nasc, col = model)) + geom_line() + theme_minimal()
calib_tbl_regiao_sudoeste %>%
modeltime_forecast(
new_data = testing(splits_regiao_sudoeste),
actual_data = regiao_sudoeste
) %>%
plot_modeltime_forecast(.conf_interval_show = FALSE)Apesar do ETS apresentar melhores resultados em termos de métricas.
future_forecast_tbl_regiao_sudoeste <- calib_tbl_regiao_sudoeste %>%
modeltime_refit(regiao_sudoeste) %>%
modeltime_forecast(h = "24 months",
actual_data = regiao_sudoeste)
future_forecast_tbl_regiao_sudoeste%>%
plot_modeltime_forecast(.conf_interval_show = FALSE)future_forecast_tbl_regiao_sudoeste %>%
filter(.model_desc == "ETS" | .model_desc == "ACTUAL") %>%
filter(.index > "2019-01-01") %>%
ggplot(aes(x = .index, y = .value, col = .key)) + geom_line() +
theme_minimal()
Criando um gráfico com os melhores modelos na base de teste
teste <- rbind(ets_treino_regiao_sudoeste,
ets_treino_regiao_centro_norte,
ets_treino_regiao_centro_oeste,
ets_treino_regiao_centro_sudeste,
arima_treino_regiao_nordeste,
resultados_mlp_graph)
b <- teste %>%
ggplot(aes(x = mes_ano, y = total_nasc, col = model)) + geom_line(size = 0.8) +
facet_wrap(~macrorregiao_pad, nrow = 5, scales = 'free') + theme_minimal() +
xlab("Mês e ano") + ylab("Nascimentos")
plotly::ggplotly(b)Previsões
Vamos pegar os dados de previsão da MLP para todas as macrorregiões, com exceção da macrorregião Nordeste, on o Arima performou melhor
resultados_mlp_previsoes <-
resultados_mlp_prophet %>%
filter(model == 'mlp') %>%
mutate(model = 'MLP') %>%
select(-`...1`) %>%
mutate(mes_ano = my(mes_ano)) %>%
mutate(macrorregiao_pad = case_when(codibge == 5206 ~ 'MACRORREGIAO SUDOESTE',
codibge == 5207 ~ 'MACRORREGIAO NORDESTE',
codibge == 5208 ~ 'MACRORREGIAO CENTRO-OESTE',
codibge == 5209 ~ 'MACRORREGIAO CENTRO-NORTE',
codibge == 5210 ~ 'MACRORREGIAO CENTRO SUDESTE')) %>%
select(macrorregiao_pad, mes_ano, model, total_nasc) %>%
filter(mes_ano > '2021-12-01') %>%
filter(macrorregiao_pad != 'MACRORREGIAO NORDESTE')
resultado_arima_previsoes <-
future_forecast_tbl_regiao_nordeste %>%
filter(.model_id == 1 & .key == 'prediction') %>%
mutate(macrorregiao_pad = 'MACRORREGIAO NORDESTE',
model = 'ARIMA') %>%
rename(mes_ano = .index,
total_nasc = .value) %>%
select(macrorregiao_pad,
mes_ano, model,
total_nasc)
previsoes <- rbind(resultados_mlp_previsoes,
resultado_arima_previsoes)